unit Unit1;
interface
uses
OleAuto,
Unit2; { Smart Objects: Access to TFrmSample }
{****************************************************************}
{ }
{ TurboCAD for Windows }
{ Copyright (c) 1993 - 1997 }
{ International Microcomputer Software, Inc. }
{ (IMSI) }
{ All rights reserved. }
{ }
{****************************************************************}
type
TRoundedRect = class(TAutoObject)
private
{ Private declarations }
MyForm: TFrmSample; { Property Page form }
function GetDescription: string;
function GetClassID: string;
automated
{ Automated declarations }
{ Smart Objects: Required properties and methods for Regen Methods }
property Description: string read GetDescription;
property ClassID: string read GetClassID;
function GetEnumNames(PropID: Integer; var Names: Variant;
var Values: Variant): Integer;
function GetPageInfo(AGraphic: Variant; var StockPages: Integer;
var Names: Variant): Integer;
function GetPropertyInfo(var Names: Variant; var Types: Variant;
var IDs: Variant; var Defaults: Variant): Integer;
function GetWizardInfo(var Names: Variant): Integer;
function Draw(GrfThis: Variant; View: Variant; mat: Variant)
: WordBool;
procedure OnGeometryChanged(Graphic: Variant; GeomID: Longint;
paramOld: Variant; paramNew: Variant);
function OnGeometryChanging(Graphic: Variant; GeomID: Integer;
paramOld: Variant; paramNew: Variant): WordBool;
function OnNewGraphic(grfThis: Variant; boolCopy: WordBool): WordBool;
function OnCopyGraphic(grfCopy: Variant; grfSource: Variant): WordBool;
procedure OnPropertyChanged(Graphic: Variant; PropID: Integer;
OldValue: Variant; NewValue: Variant);
function OnPropertyChanging(Graphic: Variant; PropID: Integer;
OldValue: Variant; NewValue: Variant): WordBool;
procedure OnPropertyGet(Graphic: Variant; PropID: Integer);
function PageControls(ThisRegenMethod: Variant; Graphic: Variant; PageNumber: Integer;
SaveProperties: WordBool): WordBool;
procedure PageDone(ThisRegenMethod: Variant; PageNumber: Variant);
function PropertyPages(ThisRegenMethod: Variant; PageNumber: Variant): WordBool;
procedure Regen(grfThis: Variant);
function Wizard(ThisRegenMethod: Variant; WizardNumber: Variant): WordBool;
end;
{$IFNDEF TARGET_EXE}
{ DLL Note: GetServerProgIDs is a required export for use by TurboCAD. }
{ It is needed because Delphi does not create type libraries. }
function GetServerProgIDs(var ProgIDs: Variant) : Integer;
{ EXE Note: Comment these exports out if building an EXE Automation server. }
{ Required exports for .DLL servers and TurboCAD Delphi extensions. }
exports
DllGetClassObject, DllCanUnloadNow,
DllRegisterServer, DllUnregisterServer,
GetServerProgIDs;
{$ENDIF}
implementation
uses SysUtils, Dialogs; { Required for StrToFloat, etc. }
const
{ Smart Objects: Make AutoClassInfo accessible to other functions }
{ Needed because Delphi does not create type libraries }
AutoClassInfo: TAutoClassInfo = (
AutoClass: TRoundedRect;
ProgID: 'RRect.RoundedRect';
ClassID: '{4EA25981-A43C-11D0-A115-00A024158DAF}';
Description: 'Rounded Rectangle Example';
Instancing: acMultiInstance);
{ DBAPI constants }
gkGraphic = 11;
gkArc = 2;
gkText = 6;
gfCosmetic = 128;
{ Useful math constants }
Pi: double = 3.14159265;
{ Special variant types }
typeIntegerEnum = varSmallint + 100;
typeLongEnum = varInteger + 100;
typeStringEnum = varOleStr + 100;
{ Stock property pages }
ppStockPen = 1;
ppStockBrush = 2;
ppStockText = 4;
ppStockInsert = 8;
ppStockViewport = 16;
ppStockAuto = 32;
{ Property Ids }
idRoundness = 1;
{ Property enums }
{ Number of properties, pages, wizards }
NUM_PROPERTIES = 1;
NUM_PAGES = 1;
NUM_WIZARDS = 0;
{ TRoundedRect object methods }
{ Returns the user-visible description of this RegenMethod }
function TRoundedRect.GetDescription: string;
begin
GetDescription := AutoClassInfo.Description;
end;
{ Returns the persistent class id for this RegenMethod's property section }
function TRoundedRect.GetClassID: string;
begin
GetClassID := AutoClassInfo.ClassID;
end;
{ Retrieve types and names }
function TRoundedRect.GetPropertyInfo(var Names: Variant; var Types: Variant;
var IDs: Variant; var Defaults: Variant): Integer;
begin
try
VarArrayRedim(Names, NUM_PROPERTIES);
VarArrayRedim(Types, NUM_PROPERTIES);
VarArrayRedim(IDs, NUM_PROPERTIES);
VarArrayRedim(Defaults, NUM_PROPERTIES);
Names[0] := 'Roundness';
Types[0] := varDouble;
IDs[0] := idRoundness;
Defaults[0] := 50.0;
Result := NUM_PROPERTIES;
except
Result := 0;
end;
end;
{ Get the number of property pages supporting this RegenMethod }
function TRoundedRect.GetPageInfo(AGraphic: Variant; var StockPages: Integer;
var Names: Variant): Integer;
begin
VarArrayRedim(Names, NUM_PAGES);
{ Need the form }
MyForm := TFrmSample.Create(Application);
Names[0] := MyForm.Caption;
MyForm.Free;
StockPages := ppStockBrush + ppStockPen + ppStockAuto;
GetPageInfo := NUM_PAGES;
end;
{ Get the number of wizards supporting this RegenMethod }
function TRoundedRect.GetWizardInfo(var Names: Variant): Integer;
begin
GetWizardInfo := NUM_WIZARDS;
end;
{ Enumerate the names and values of a specified property }
function TRoundedRect.GetEnumNames(PropID: Integer; var Names: Variant;
var Values: Variant): Integer;
begin
GetEnumNames := 0;
end;
function TRoundedRect.PageControls(ThisRegenMethod: Variant; Graphic: Variant; PageNumber: Integer;
SaveProperties: WordBool): WordBool;
var
Roundness: double;
begin
try
if SaveProperties then
begin
{ OK button on property page was clicked }
{ Form is still loaded }
with MyForm do
begin
{ Need try block for the case where you have }
{ TRoundedRect Turbo Shape and ahother "shape" selected }
try
{ When the property page is closed, transfer the numeric }
{ roundness value from the EditBox to the Graphic }
{ Get the value as a double-precision number }
Roundness := StrToFloat(txtRoundness.Text);
{ Make sure it's between 0 and 100 }
if Roundness < 0.0 then Roundness := 0.0;
if Roundness > 100.0 then Roundness := 100.0;
{ Set the roundness property value in the Graphic }
Graphic.Properties['Roundness'] := Roundness;
except
end;
end;
end
else
begin
{ Property page is about to be opened }
{ Make sure the form is loaded }
MyForm := TFrmSample.Create(Application);
with MyForm do
begin
{ If more than one TRoundedRect is selected and they do not }
{ have the same properties, don't set up this field }
try
{ When the property page is opening, transfer the numeric }
{ roundness value from the Graphic to the TextBox }
{ Get the roundness property value from the Graphic }
Roundness := Graphic.Properties['Roundness'];
{ Set the EditBox control's text }
txtRoundness.Text := FloatToStrF(Roundness, ffGeneral,
3, 0);
except
end;
end;
end;
PageControls := True;
except
{ For debugging purposes, report that an error occurred }
{ Return false if an error occurred }
PageControls := False;
end;
end;
procedure TRoundedRect.PageDone(ThisRegenMethod: Variant; PageNumber: Variant);
begin
{ Done with form }
MyForm.Free;
end;
function TRoundedRect.PropertyPages(ThisRegenMethod: Variant; PageNumber: Variant): WordBool;
var
PageResult: Integer;
begin
with MyForm do
begin
PageResult := ShowModal;
PropertyPages := (PageResult = mrOK);
end;
end;
function TRoundedRect.Wizard(ThisRegenMethod: Variant; WizardNumber: Variant): WordBool;
begin
Wizard := False;
end;
{ Called when vertex has been moved, or other geometry change }
procedure TRoundedRect.OnGeometryChanged(Graphic: Variant; GeomID: Longint;
paramOld: Variant; paramNew: Variant);
begin
{ Do nothing }
end;
{ Called when vertex is moved, or other geometry change }
function TRoundedRect.OnGeometryChanging(Graphic: Variant; GeomID: Integer;
paramOld: Variant; paramNew: Variant): WordBool;
begin
{ OK to continue with change }
OnGeometryChanging := True;
end;
function TRoundedRect.OnNewGraphic(grfThis: Variant; boolCopy: WordBool): WordBool;
var
R, Roundness, Offset: double;
Vertices, vTrue, vFalse: Variant;
X, Y, Z: double;
begin
if boolCopy then
begin
{ Vertices are already added for us... }
OnNewGraphic := True;
exit;
end;
try
{ New Graphic being created }
{ Temporary veriable for Vertices.Add }
Vertices := grfThis.Vertices;
{ Define True and False variants }
vTrue := True;
vFalse := False;
{ First Vertex is "lower left" corner }
{ Arguments for Vertices.Add are:
{ X, Y, Z: double; }
{ PenDown, Selectable, Snappable, Editable, Linkable, Calculated, }
{ Before, After: Variant. }
{ Specify all flags; Omit Before and After arguments. }
X := -1.0;
Y := -0.5;
Z := 0.0;
Vertices.Add(X, Y, Z,
vFalse, vTrue, vFalse, vFalse, vFalse, vFalse, , );
{ Second Vertex is "upper right" corner }
X := 1.0;
Y := 0.5;
Vertices.Add(X, Y, Z,
vFalse, vTrue, vFalse, vFalse, vFalse, vFalse, , );
{ Third Vertex is rounding handle (calculated) }
Roundness := grfThis.Properties['Roundness'];
R := 0.5 * Roundness / 100.0;
Offset := 0.1 * R;
X := 1.0 - R;
Y := 0.5 + Offset;
Vertices.Add(X, Y, Z,
vFalse, vFalse, vFalse, vFalse, vFalse, vFalse, , );
{ Fourth Vertex is rounding handle (editable) }
Vertices.Add(X, Y, Z,
vFalse, vTrue, vFalse, vTrue, vFalse, vFalse, , );
OnNewGraphic := True;
except
{ Return false on failure }
OnNewGraphic := False;
end;
end;
function TRoundedRect.OnCopyGraphic(grfCopy: Variant; grfSource: Variant): WordBool;
begin
{ OK to proceed }
OnCopyGraphic := True;
end;
{ Notification function called after graphic property is saved }
procedure TRoundedRect.OnPropertyChanged(Graphic: Variant; PropID: Integer;
OldValue: Variant; NewValue: Variant);
begin
{ Do nothing }
end;
{ Notification function called when graphic property is saved }
function TRoundedRect.OnPropertyChanging(Graphic: Variant; PropID: Integer;
OldValue: Variant; NewValue: Variant): WordBool;
begin
{ OK to proceed }
OnPropertyChanging := True;
end;
{ Notification function called when graphic property is retrieved }
procedure TRoundedRect.OnPropertyGet(Graphic: Variant; PropID: Integer);
begin
{ Do nothing }
end;
{ Called when graphic's internal structure needs to be updated }
procedure TRoundedRect.Regen(grfThis: Variant);
var
LockCount: Integer;
boolHandleMoved: WordBool;
W, H, R, Roundness: double;
X, Y, Z, X0, Y0, X1, Y1, T, StartAngle, EndAngle: double;
Props, propRoundness: Variant;
grfChild, Vertices, V0, V1, V2, V3, vTrue, vFalse: Variant;
begin
{ Setup error handler }
try
{ grfThis.Application.PushVertexDefaults Editable:=True, Selectable:=True }
{ Set up lock (prevent recursion) }
LockCount := grfThis.RegenLock;
{ Setup error handler (make sure lock is removed) }
if LockCount = 0 then
begin
try
{ Delete any previous cosmetic children }
grfThis.Graphics.Clear(gfCosmetic);
{ Calculate height, width and radius of corners }
Vertices := grfThis.Vertices;
V0 := Vertices.Item[0]; { First corner }
V1 := Vertices.Item[1]; { Diagonal corner }
V2 := Vertices.Item[2]; { Radius }
V3 := Vertices.Item[3]; { Drag handle }
if (Abs(V2.X - V3.X) < 0.000001) and
(Abs(V2.Y - V3.Y) < 0.000001) then boolHandleMoved := False
else boolHandleMoved := True;
W := Abs(V1.X - V0.X);
H := Abs(V1.Y - V0.Y);
{ Radius of arcs is based on minimum of width and height }
if W < H then R := W / 2.0
else R := H / 2.0;
{ Adjust radius for roundness }
Props := grfThis.Properties;
propRoundness := Props.Item['Roundness'];
if boolHandleMoved then
begin
Roundness := Abs(V2.X - V3.X);
Roundness := Roundness * 100.0 / R;
if Roundness > 100.0 then Roundness := 100.0;
{ Relocate handle }
{ Update property to reflect handle location }
propRoundness.Value := Roundness;
end
else
begin
Roundness := propRoundness.Value;
if Roundness < 0.0 then Roundness := 0.0;
if Roundness > 100.0 then Roundness := 100.0;
end;
R := R * Roundness / 100.0;
{ Add child Graphics }
X0 := V0.X;
Y0 := V0.Y;
X1 := V1.X;
Y1 := V1.Y;
{ Make sure X0 < X1 }
if X0 > X1 then
begin
T := X0;
X0 := X1;
X1 := T;
end;
{ Make sure Y0 < Y1 }
if Y0 > Y1 then
begin
T := Y0;
Y0 := Y1;
Y1 := T;
end;
vTrue := True;
vFalse := False;
if R = 0 then
begin
{ No rounded corners }
{ All children are cosmetic }
grfChild := grfThis.Graphics.Add( , , vTrue, , , );
grfChild.Cosmetic := True;
{ Now add vertices to the child }
Vertices := grfChild.Vertices;
X := X0;
Y := Y0;
Z := 0.0;
Vertices.Add(X, Y, Z, , , , , , , , );
Y := Y1;
Vertices.Add(X, Y, Z, vTrue, , , , , , , );
X := X1;
Vertices.Add(X, Y, Z, vTrue, , , , , , , );
Y := Y0;
Vertices.Add(X, Y, Z, vTrue, , , , , , , );
{ Close the rectangle }
Vertices.AddClose(vTrue, , , , , );
end
else
begin
{ Rounded corners }
{ We'll make 4 line children and 4 arc children }
{ First line }
{ All children are cosmetic }
grfChild := grfThis.Graphics.Add( , , vTrue, , , );
grfChild.Cosmetic := True;
{ Now add vertices to the child }
Vertices := grfChild.Vertices;
X := X0 + R;
Y := Y0;
Z := 0;
Vertices.Add(X, Y, Z, , , , , , , , );
X := X1 - R;
Vertices.Add(X, Y, Z, vTrue, , , , , , , );
{ First arc }
grfChild := grfThis.Graphics.Add(gkArc, , vTrue, , , );
grfChild.Cosmetic := True;
Y := Y0 + R;
StartAngle := 1.5 * Pi;
EndAngle := 0.0;
grfChild.ArcSet(X, Y, Z, R, , StartAngle, EndAngle, );
{ Second line }
grfChild := grfThis.Graphics.Add( , , vTrue, , , );
grfChild.Cosmetic := True;
Vertices := grfChild.Vertices;
X := X1;
Vertices.Add(X, Y, Z, , , , , , , , );
Y := Y1 - R;
Vertices.Add(X, Y, Z, vTrue, , , , , , , );
{ Second arc }
grfChild := grfThis.Graphics.Add(gkArc, , vTrue, , , );
grfChild.Cosmetic := True;
X := X1 - R;
StartAngle := 0.0;
EndAngle := 0.5 * Pi;
grfChild.ArcSet(X, Y, Z, R, , StartAngle, EndAngle, );
{ Third line }
grfChild := grfThis.Graphics.Add( , , vTrue, , , );
grfChild.Cosmetic := True;
Vertices := grfChild.Vertices;
Y := Y1;
Vertices.Add(X, Y, Z, , , , , , , , );
X := X0 + R;
Vertices.Add(X, Y, Z, vTrue, , , , , , , );
{ Third arc }
grfChild := grfThis.Graphics.Add(gkArc, , vTrue, , , );
grfChild.Cosmetic := True;
Y := Y1 - R;
StartAngle := 0.5 * Pi;
EndAngle := Pi;
grfChild.ArcSet(X, Y, Z, R, , StartAngle, EndAngle, );
{ Fourth line }
grfChild := grfThis.Graphics.Add( , , vTrue, , , );
grfChild.Cosmetic := True;
Vertices := grfChild.Vertices;
X := X0;
Vertices.Add(X, Y, Z, , , , , , , , );
Y := Y0 + R;
Vertices.Add(X, Y, Z, vTrue, , , , , , , );
{ Fourth arc }
grfChild := grfThis.Graphics.Add(gkArc, , vTrue, , , );
grfChild.Cosmetic := True;
X := X0 + R;
StartAngle := Pi;
EndAngle := 1.5 * Pi;
grfChild.ArcSet(X, Y, Z, R, , StartAngle, EndAngle, );
end;
{ Add visible child Graphics }
except
end;
end; { if LockCount = 0 }
{ Remove lock }
grfThis.RegenUnlock;
{ grfThis.Application.PopVertexDefaults }
except
end;
end;
{ Called to do special draw proocessing }
function TRoundedRect.Draw(GrfThis: Variant; View: Variant; mat: Variant)
: WordBool;
begin
{ Return True if we did the redraw (no further processing necessary, }
{ no children will be drawn). }
{ Since this is just a test, we return False to let TurboCAD do the }
{ drawing operation. }
Draw := False;
end;
{$IFNDEF TARGET_EXE}
{ DLL Note: GetServerProgIDs is a required function for TurboCAD extensions. }
{ EXE Note: Comment out GetServerProgIDs if you are building an EXE server,
{ and see the note below regarding required resources. }
{ In lieu of type library, we need to get the CLSID of the OleAuto }
{ object somehow. Once we have the CLSID, we can merrily call }
{ CoCreateInstance to get an object... }
function GetServerProgIDs(var ProgIDs: Variant) : Integer;
begin
VarArrayRedim(ProgIDs, 1); { Redimension array }
ProgIDs[0] := AutoClassInfo.ProgID; { Return ProgID in array element }
GetServerProgIDs := 1; { Return size of array }
end;
{$ELSE}
{ EXE Note: When building an .EXE server, you should add a resource named }
{ "ProgIDs" of type RCDATA with the ProgID strings separated by NUL }
{ characters. For example, this server would contain a resource file }
{ generated from the following .RC file: }
{
ProgIDs RCDATA
BEGIN
"RRect.RoundedRect\0"
END
}
{ Save the script in a file called "ProgIds.rc". }
{ Compile ProgIds.rc using "Brc32.exe -r ProgIds.rc". }
{ Include the resulting .RES file in our project with the $RESOURCE directive. }
{ using Delphi's $RESOURCE directive in the DPR file. }
{$ENDIF}
procedure RegisterRoundedRect;
begin
Automation.RegisterClass(AutoClassInfo);
end;
initialization
RegisterRoundedRect;
end.
SDK Top API Reference TurboCAD Home Page TurboCAD Programming Forums